home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / gui / desigdemo.lha / DesignerDemo / MultipleDemo / MultipleDemo.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-13  |  5KB  |  168 lines
  1. program MultipleDemoPascalMain;
  2.  
  3. Uses exec,intuition,gadtools,graphics,amiga,diskfont,
  4.      workbench,utility,MultipleDemoPascal,defs;
  5.  
  6. Var
  7.   done        : boolean;
  8.   class       : long;
  9.   code        : word;
  10.   pgsel       : pGadget;
  11.   imsg        : pintuimessage;
  12.   dummy       : long;
  13.   twindowlist : tlist;
  14.   pwinnode    : pwindownode;
  15.   pwinnode2   : pwindownode;
  16.   mymsgport   : pmsgport;
  17.   loop        : long;
  18.   count       : long;
  19.   
  20. function openonewin : boolean;
  21. begin
  22.   openonewin:=false;
  23.   pwinnode2:=allocmem(sizeof(twindownode),memf_any or memf_clear);
  24.   if pwinnode2<>nil then
  25.     begin
  26.       if openwindowpwinnodepwin(mymsgport,pwinnode2) then
  27.         begin
  28.           openonewin:=true;
  29.           pwinnode2^.pwin^.userdata:=pointer(pwinnode2);
  30.           addtail(@twindowlist,pnode(pwinnode2));
  31.         end
  32.        else
  33.         freemem(pwinnode,sizeof(twindownode));
  34.     end;
  35.   count:=0;
  36.   pwinnode2:=pwindownode(twindowlist.lh_head);
  37.   while (pwinnode2^.ln_succ<>nil) do
  38.     begin
  39.       inc(count);
  40.       gt_setsinglegadgetattr(pwinnode2^.pwingads[commonwin_gad2],pwinnode2^.pwin,
  41.                              gtnm_number,count);
  42.       pwinnode2:=pwinnode2^.ln_succ;
  43.     end;
  44. end;
  45.  
  46. procedure closeonewin(pwn : pwindownode);
  47. begin
  48.   remove(pnode(pwn));
  49.   closewindowpwinnodepwin(pwn);
  50.   freemem(pwinnode,sizeof(twindownode));
  51.   count:=0;
  52.   pwinnode2:=pwindownode(twindowlist.lh_head);
  53.   while (pwinnode2^.ln_succ<>nil) do
  54.     begin
  55.       inc(count);
  56.       gt_setsinglegadgetattr(pwinnode2^.pwingads[commonwin_gad2],pwinnode2^.pwin,
  57.                              gtnm_number,count);
  58.       pwinnode2:=pwinnode2^.ln_succ;
  59.     end;
  60. end;
  61.  
  62. Procedure ProcessMenuIDCMPCommonMenu( MenuNumber : word);
  63. Var
  64.   ItemNumber : Word;
  65.   Item       : pMenuItem;
  66. Begin
  67.   while (MenuNumber<>MENUNULL) do
  68.     Begin
  69.       Item:=ItemAddress( CommonMenu, MenuNumber);
  70.       ItemNumber:=ITEMNUM(MenuNumber);
  71.       MenuNumber:=MENUNUM(MenuNumber);
  72.       Case MenuNumber of
  73.         CommonMenu_Options :
  74.           Case ItemNumber of
  75.             CommonMenu_Options_Item0 :
  76.               Begin
  77.                 pwinnode2:=pwindownode(remhead(@twindowlist));
  78.                 while (pwinnode2<>nil) do
  79.                   begin
  80.                     if twindowlist.lh_head^.ln_succ=nil then
  81.                       begin
  82.                         addhead(@twindowlist,pnode(pwinnode2));
  83.                         pwinnode2:=nil;
  84.                       end
  85.                      else
  86.                       begin
  87.                         closeonewin(pwinnode2);
  88.                         pwinnode2:=pwindownode(remhead(@twindowlist));
  89.                       end;
  90.                   end;
  91.               end;
  92.             CommonMenu_Options_Item2 :
  93.               Begin
  94.                 pwinnode2:=pwindownode(remhead(@twindowlist));
  95.                 while (pwinnode2<>nil) do
  96.                   begin
  97.                     closeonewin(pwinnode2);
  98.                     pwinnode2:=pwindownode(remhead(@twindowlist));
  99.                   end;
  100.                 done:=true;
  101.               end;
  102.            end;
  103.        end;
  104.       MenuNumber:=Item^.NextSelect;
  105.     end;
  106. end;
  107.  
  108. Begin
  109.   newlist(@twindowlist);
  110.   done:=false;
  111.   if OpenLibs then
  112.     Begin
  113.       mymsgport:=createmsgport;
  114.       if mymsgport<>nil then
  115.         begin
  116.           if openonewin then
  117.             while (not done) do
  118.                  begin
  119.                 dummy:=Wait(bitmask(mymsgport^.mp_SigBit));
  120.                 imsg:=GT_GetIMsg(mymsgport);
  121.                 while (imsg <>nil ) do
  122.                     begin
  123.                     class:=imsg^.Class;
  124.                       code:=imsg^.Code;
  125.                     pgsel:=pgadget(imsg^.IAddress);
  126.                     pwinnode:=pointer(imsg^.idcmpwindow^.userdata);
  127.                     GT_ReplyIMsg(imsg);
  128.                     case class of
  129.                       IDCMP_GADGETUP :
  130.                         Begin
  131.                           Case pgsel^.gadgetid of
  132.                             CommonWin_Gad0 :
  133.                               Begin
  134.                                 if not openonewin then
  135.                                   writeln('Could not open window.');
  136.                               end;
  137.                             CommonWin_Gad1 :
  138.                               Begin
  139.                                 for loop:=1 to 5 do
  140.                                   if not openonewin then
  141.                                     writeln('Could not open window.');
  142.                               end;
  143.                            end;
  144.                         end;
  145.                       IDCMP_CLOSEWINDOW :
  146.                         begin
  147.                           closeonewin(pwinnode);
  148.                           if twindowlist.lh_head^.ln_succ=nil then
  149.                             done:=true;
  150.                         end;
  151.                       IDCMP_MENUPICK :
  152.                         ProcessMenuIDCMPCommonMenu( Code );
  153.                      end;
  154.                     imsg:=GT_GetIMsg(mymsgport);
  155.                   end;
  156.               end;
  157.           if commonmenu<>nil then
  158.             freemenus(commonmenu);
  159.           deletemsgport(mymsgport);
  160.         end
  161.        else
  162.         writeln('Cannot make msg port.');
  163.       CloseLibs;
  164.     end
  165.    else
  166.     writeln('Cannot open libraries.');
  167. end.
  168.